home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tex / mf / inputs / misc / feynmf.mf < prev    next >
Text File  |  1995-03-15  |  35KB  |  1,138 lines
  1. %% 
  2. %% This is file `feynmf.mf', generated 
  3. %% on <1995/3/4> with the docstrip utility (2.2i).
  4. %% 
  5. %% The original source files were:
  6. %% 
  7. %% feynmf.dtx  (with options: `base')
  8. %% 
  9. %% Copyright (C) 1989, 1990, 1992-1995 by Thorsten.Ohl@Physik.TH-Darmstadt.de 
  10. %% 
  11. %% This file is NOT the source for feynmf, because almost all comments 
  12. %% have been stripped from it. It is NOT the preferred form of feynmf 
  13. %% for making modifications to it. 
  14. %% 
  15. %% Therefore you can NOT redistribute and/or modify THIS file. You can 
  16. %% however redistribute the complete source (feynmf.dtx and feynmf.ins) 
  17. %% and/or modify it under the terms of the GNU General Public License as 
  18. %% published by the Free Software Foundation; either version 2, or (at 
  19. %% your option) any later version. 
  20. %% 
  21. %% Feynmf is distributed in the hope that it will be useful, but 
  22. %% WITHOUT ANY WARRANTY; without even the implied warranty of 
  23. %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
  24. %% GNU General Public License for more details. 
  25. %% 
  26. %% You should have received a copy of the GNU General Public License 
  27. %% along with this program; if not, write to the Free Software 
  28. %% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 
  29. %% 
  30. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  31. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  32. %% \CheckSum{553}
  33. %% \CharacterTable
  34. %%  {Upper-case    \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
  35. %%   Lower-case    \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
  36. %%   Digits        \0\1\2\3\4\5\6\7\8\9
  37. %%   Exclamation   \!     Double quote  \"     Hash (number) \#
  38. %%   Dollar        \$     Percent       \%     Ampersand     \&
  39. %%   Acute accent  \'     Left paren    \(     Right paren   \)
  40. %%   Asterisk      \*     Plus          \+     Comma         \,
  41. %%   Minus         \-     Point         \.     Solidus       \/
  42. %%   Colon         \:     Semicolon     \;     Less than     \<
  43. %%   Equals        \=     Greater than  \>     Question mark \?
  44. %%   Commercial at \@     Left bracket  \[     Backslash     \\
  45. %%   Right bracket \]     Circumflex    \^     Underscore    \_
  46. %%   Grave accent  \`     Left brace    \{     Vertical bar  \|
  47. %%   Right brace   \}     Tilde         \~}
  48. %%
  49. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  50. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  51. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  52. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  53. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  54. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  55. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  56. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  57. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  58. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  59. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  60. if known cmbase:
  61.   errhelp
  62.     "feynmf will only work with plain Metafont, as described in the book.";
  63.   errmessage "feynmf: CMBASE detected.  Please use the PLAIN base.";
  64.   forever:
  65.     errmessage "No use in trying!  You'd better eXit now ...";
  66.     errorstopmode;
  67.   endfor
  68. fi
  69. vardef parse_RCS (suffix RCS) (expr s) =
  70.   save n, c;
  71.   numeric n, RCS[];
  72.   string c;
  73.   RCS[0] := 0;
  74.   for n = 1 upto length (s):
  75.     c := substring (n-1,n) of s;
  76.     exitif ((RCS[0] > 0) and (c = " "));
  77.     if ((c = "0") or (c = "1") or (c = "2")
  78.         or (c = "3") or (c = "4") or (c = "5")
  79.         or (c = "6") or (c = "7") or (c = "8")
  80.         or (c = "9")):
  81.       if RCS[0] = 0:
  82.         RCS[0] := 1;
  83.         RCS[RCS[0]] := 0;
  84.       fi
  85.       RCS[RCS[0]] := 10 * RCS[RCS[0]] + scantokens (c);
  86.     elseif c = ".":
  87.       RCS[0] := RCS[0] + 1;
  88.       RCS[RCS[0]] := 0;
  89.     else:
  90.     fi
  91.   endfor
  92. enddef;
  93. vardef require_RCS_revision expr s =
  94.   save n, TeX_rev, mf_rev;
  95.   numeric n;
  96.   parse_RCS (TeX_rev, s);
  97.   parse_RCS (mf_rev, "1.10");
  98.   for n = 1 upto min (2, TeX_rev[0], mf_rev[0]):
  99.     if TeX_rev[n] > mf_rev[n]:
  100.       errhelp
  101.         "Your version of `feynmf.sty' is higher that of your `feynmf.mf'.";
  102.       errmessage "feynmf: Metafont macros out of date";
  103.     elseif TeX_rev[n] < mf_rev[n]:
  104.       errhelp
  105.         "Your version of `feynmf.mf' is higher that of your `feynmf.sty'.";
  106.       errmessage "feynmf: LaTeX style out of date";
  107.     fi
  108.     exitif (TeX_rev[n] <> mf_rev[n]);
  109.   endfor
  110. enddef;
  111. mode_setup;
  112. boolean feynmfwizard;
  113. feynmfwizard := false;
  114. thin#:=1pt#; % dimension of the lines
  115. thick#:=2thin#;
  116. arrow_len# := 4mm#;
  117. arrow_ang := 15;
  118. curly_len#:=3mm#;
  119. dash_len#:=3mm#; % 'photon' lines
  120. dot_len#:=2mm#; % 'photon' lines
  121. wiggly_len#:=4mm#; % 'photon' lines
  122. wiggly_slope:=60;
  123. shade_black#:=1pt#; % shading
  124. shade_white#:=2shade_black#;
  125. shade_angle:=60;
  126. decor_size#:=5mm#;
  127. dot_size#:=2thick#;
  128. define_blacker_pixels (thick, thin, shade_black, shade_white,
  129.   dash_len, dot_len, wiggly_len, curly_len, arrow_len,
  130.   decor_size, dot_size);
  131. def shrink expr s =
  132.   begingroup
  133.   if shrinkables <> "":
  134.     save tmp_;
  135.     forsuffixes $ = scantokens shrinkables:
  136.       tmp_ := $.#;
  137.       save $;
  138.       $.# := s * tmp_;
  139.     endfor
  140.     define_blacker_pixels (scantokens shrinkables);
  141.   fi
  142. enddef;
  143. def endshrink =
  144.   endgroup
  145. enddef;
  146. string shrinkables;
  147. shrinkables := "";
  148. vardef addto_shrinkables (text l) =
  149.   forsuffixes $ = l:
  150.     shrinkables := shrinkables & "," & str $;
  151.   endfor
  152. enddef;
  153. shrinkables := "thick,thin";
  154. addto_shrinkables (shade_black, shade_white);
  155. addto_shrinkables (dash_len, dot_len);
  156. addto_shrinkables (wiggly_len, curly_len);
  157. addto_shrinkables (arrow_len);
  158. addto_shrinkables (decor_size, dot_size);
  159. LaTeX_unitlength := mm;
  160. vardef count (text list) =
  161.   forsuffixes $ = list: + 1 endfor
  162. enddef;
  163. vardef getopt (suffix opt) (expr s) =
  164.   save n, argp, escape, anchor, skip;
  165.   numeric opt.first, opt.last, n, anchor;
  166.   string opt[], opt[]arg;
  167.   boolean opt[]tainted, argp, escape, skip;
  168.   opt.first := 0;
  169.   opt.last := 0;
  170.   opt[opt.last] := "";
  171.   argp := false;
  172.   escape := false;
  173.   anchor := 0;
  174.   skip := true;
  175.   for n = 1 upto length (s):
  176.     if skip and (substring (n-1, n) of s = " "):
  177.       anchor := anchor + 1;
  178.     else:
  179.       skip := false;
  180.       if not escape and (substring (n-1, n) of s = ","):
  181.         if substring (n, n+1) of s = ",":
  182.           escape := true;
  183.           opt[opt.last]tainted := true;
  184.         else:
  185.           if argp:
  186.             opt[opt.last]arg := substring (anchor, n-1) of s;
  187.           else:
  188.             opt[opt.last] := substring (anchor, n-1) of s;
  189.           fi
  190.           anchor := n;
  191.           argp := false;
  192.           skip := true;
  193.           opt.last := opt.last + 1;
  194.         fi
  195.       elseif not argp and (substring (n-1, n) of s = "="):
  196.         opt[opt.last] := substring (anchor, n-1) of s;
  197.         anchor := n;
  198.         argp := true;
  199.         skip := true;
  200.       elseif argp or (substring (n-1, n) of s <> " "):
  201.         escape := false;
  202.       fi
  203.     fi
  204.   endfor
  205.   if argp:
  206.     opt[opt.last]arg := substring (anchor, length s) of s;
  207.   else:
  208.     opt[opt.last] := substring (anchor, length s) of s;
  209.   fi
  210.   for n = opt.first upto opt.last:
  211.     if known opt[n]tainted:
  212.       if opt[n]tainted:
  213.         opt[n]arg := untaint_string opt[n]arg;
  214.       fi
  215.     fi
  216.   endfor
  217. enddef;
  218. vardef untaint_string suffix s =
  219.   save n, anchor;
  220.   numeric n, anchor;
  221.   anchor := 0;
  222.   for n = 1 upto length (s) - 1:
  223.     if substring (n-1,n+1) of s = ",,":
  224.       substring (anchor, n-1) of s &
  225.       hide (anchor := n)
  226.     fi
  227.   endfor
  228.   substring (anchor, length s) of s
  229. enddef;
  230. vardef split_string (suffix comp) (expr s) =
  231.   save n, anchor;
  232.   numeric comp.first, comp.last, n, anchor;
  233.   string comp[];
  234.   comp.first := 0;
  235.   comp.last := 0;
  236.   comp[comp.last] := "";
  237.   anchor := 0;
  238.   for n = 1 upto length (s):
  239.     if substring (n-1,n) of s = ".":
  240.       comp[comp.last] := substring (anchor, n-1) of s;
  241.       comp.last := comp.last + 1;
  242.       anchor := n;
  243.     fi
  244.   endfor
  245.   comp[comp.last] := substring (anchor, length s) of s;
  246. enddef;
  247. vardef match_prefix (expr prefix, s) =
  248.   (prefix = substring (0, length prefix) of s)
  249. enddef;
  250. vardef match_option (expr s, option) =
  251.   save sc, optionc, n, i;
  252.   numeric sc.first, sc.last, optionc.first, optionc.last;
  253.   string sc[], optionc[];
  254.   numeric n, i;
  255.   split_string (sc, s);
  256.   split_string (optionc, option);
  257.   n := sc.last - sc.first;
  258.   if n <> (optionc.last - optionc.first):
  259.     false
  260.   else:
  261.     true
  262.     for i = 0 upto n:
  263.       and match_prefix (sc[sc.first+i],
  264.                         optionc[optionc.first+i])
  265.     endfor
  266.   fi
  267. enddef;
  268. def save_picture text t =
  269.  save t; picture t; forsuffixes p=t: p:=nullpicture; endfor
  270. enddef;
  271. def begin_sketch =
  272.  begingroup save_picture currentpicture;
  273.  sketchlevel := sketchlevel+1;
  274. enddef;
  275. def end_sketch =
  276.  sketchlevel := sketchlevel-1;
  277.  sketchpad[sketchlevel] := currentpicture;
  278.  endgroup
  279. enddef;
  280. picture sketchpad[];
  281. sketchlevel := 1;
  282. vardef use_sketch text t =
  283.  addto currentpicture also (sketchpad[sketchlevel] t)
  284. enddef;
  285. vardef shade expr p_arg =
  286.  save x,y,d,p,currentpen; path p; pen currentpen;    % push pen!
  287.  pickup pencircle scaled shade_black;
  288.  p = p_arg rotated - shade_angle;  % calculate enclosing rectangle
  289.  x2' = x3' = xpart directionpoint up of p; % (rotated by |shade_angle|).
  290.  x1' = x4' = xpart directionpoint down of p;
  291.  y1' = y2' = ypart directionpoint right of p;
  292.  y3' = y4' = ypart directionpoint left of p;
  293.  forsuffixes $=1,2,3,4: z$ = z$' rotated shade_angle; endfor
  294.  d = abs(z1-z4); % height.
  295.  begin_sketch % fill rectangle with lines.
  296.   for k=shade_white/d step (shade_white+shade_black)/d
  297.     until 1 - shade_white/d:
  298.    cutdraw k[z1,z4] -- k[z2,z3];
  299.   endfor
  300.   cullit;
  301.   fill p_arg;
  302.   unfill z1--z2--z3--z4--cycle;
  303.   cullit;
  304.  end_sketch;
  305.  use_sketch;
  306. enddef;
  307. vardef hatch expr p =
  308.   shade p;
  309.   save a;
  310.   a = shade_angle;
  311.   save shade_angle;
  312.   shade_angle = a + 90;
  313.   shade p;
  314. enddef;
  315. vardef shadedraw expr p =
  316.   shade p;
  317.   draw p;
  318. enddef;
  319. vardef hatchdraw expr p =
  320.   hatch p;
  321.   draw p;
  322. enddef;
  323. vardef arrow expr p =
  324.   save t, a, z_, ap_, tip;
  325.   numeric t[], a;
  326.   pair z_, tip;
  327.   path ap_;
  328.   a = angle direction .5 length(p) of p;
  329.   z_ = point .5 length(p) of p;
  330.   (t1,whatever) = p intersectiontimes
  331.     (halfcircle scaled 2/3arrow_len rotated (a+90) shifted z_);
  332.   (t2,whatever) = p intersectiontimes
  333.     (halfcircle scaled 4/3arrow_len rotated (a-90) shifted z_);
  334.   if t1 = -1: t1 := 0; fi
  335.   if t2 = -1: t2 := length p; fi
  336.   tip = point t2 of p;
  337.   ap_ = subpath (t1,t2) of p shifted -tip;
  338.   (ap_ rotated arrow_ang
  339.     forced_join reverse ap_ rotated -arrow_ang
  340.     -- cycle) shifted tip
  341. enddef;
  342. tertiarydef p forced_join q =
  343.   subpath (0, length p - 1) of p
  344.   & point (length p - 1) of p
  345.     .. controls postcontrol (length p - 1) of p
  346.                 and precontrol infinity of p
  347.   .. .5[point infinity of p, point 0 of q]
  348.     .. controls postcontrol 0 of q and precontrol 1 of q
  349.     .. point 1 of q
  350.   & subpath (1, infinity) of q
  351. enddef;
  352. vardef cut_decors (suffix from) (expr p) (suffix to) =
  353.  subpath (if known from.decor.shape:
  354.             xpart (p intersectiontimes
  355.                      (from.decor.shape scaled from.decor.size
  356.                                        shifted from.loc))
  357.           else:
  358.             0
  359.           fi,
  360.           if known to.decor.shape:
  361.             xpart (p intersectiontimes
  362.                      (to.decor.shape scaled to.decor.size
  363.                                      shifted to.loc))
  364.          else:
  365.             infinity
  366.          fi) of p
  367. enddef;
  368. vardef make_blob (expr z_arg, diameter) =
  369.  save p,currentpen; path p; pen currentpen;
  370.  pickup pencircle scaled thick;
  371.  p = fullcircle scaled diameter shifted z_arg;
  372.  shadedraw p;
  373. enddef;
  374. vardef draw_blob (expr z_arg, diameter) =
  375.  if sketched_blob_diameter <> diameter: % drawn lately?
  376.   begin_sketch make_blob (origin, diameter); end_sketch; % redo hard work!
  377.   sketched_blob_diameter:= diameter;  % record it
  378.  fi
  379.  use_sketch shifted z_arg; % the easy way ...
  380. enddef;
  381. def force_new_blob = sketched_blob_diameter := -1; enddef;
  382. force_new_blob;                                 % initialize it.
  383. vardef pixlen (expr p, n) =
  384.   for k=1 upto length(p): + segment_pixlen (subpath (k-1,k) of p, n) endfor
  385. enddef;
  386. vardef segment_pixlen (expr p, n) =
  387.   for k=1 upto n: + abs (point k/n of p - point (k-1)/n of p) endfor
  388. enddef;
  389. vardef wiggly expr p_arg =
  390.  save wpp;
  391.  numeric wpp;
  392.  wpp = ceiling (pixlen (p_arg, 10) / (wiggly_len * length(p_arg)));
  393.  for k=0 upto wpp*length(p_arg) - 1:
  394.   point k/wpp of p_arg
  395.        {direction k/wpp of p_arg rotated wiggly_slope} ..
  396.   point (k+.5)/wpp of p_arg
  397.        {direction (k+.5)/wpp of p_arg rotated - wiggly_slope} ..
  398.  endfor
  399.  if cycle p_arg: cycle else: point infinity of p_arg fi
  400. enddef;
  401.  
  402. vardef curly expr p_arg =
  403.  save cpp;
  404.  numeric cpp;
  405.  cpp = ceiling (pixlen (p_arg, 10) / (curly_len * length(p_arg)));
  406.  if cycle p_arg:
  407.    for k=0 upto cpp*length(p_arg) - 1:
  408.      point (k+.33)/cpp of p_arg
  409.            {direction (k+.33)/cpp of p_arg rotated 90} ..
  410.      point (k-.33)/cpp of p_arg
  411.            {direction (k-.33)/cpp of p_arg rotated -90} ..
  412.    endfor
  413.    cycle
  414.  else:
  415.    point 0 of p_arg
  416.          {direction 0 of p_arg rotated -90} ..
  417.    for k=1 upto cpp*length(p_arg) - 1:
  418.      point (k+.33)/cpp of p_arg
  419.            {direction (k+.33)/cpp of p_arg rotated 90} ..
  420.      point (k-.33)/cpp of p_arg
  421.            {direction (k-.33)/cpp of p_arg rotated -90} ..
  422.    endfor
  423.    point infinity of p_arg
  424.          {direction infinity of p_arg rotated 90}
  425.  fi
  426. enddef;
  427. save vsty_hash;
  428. def style_def suffix s =
  429.   vsty_hash.s := 1;
  430.   expandafter quote vardef scantokens ("draw_" & str s)
  431. enddef;
  432. vardef vsty_exists suffix s =
  433.   known vsty_hash.s
  434. enddef;
  435. vardef valid_style expr s =
  436.   expandafter vsty_exists scantokens (s)
  437. enddef;
  438. style_def phantom expr p =
  439.   \
  440. enddef;
  441. style_def phantom_arrow expr p =
  442.   fill (arrow p);
  443. enddef;
  444. style_def plain expr p =
  445.   draw p;
  446. enddef;
  447. style_def plain_arrow expr p =
  448.   draw p;
  449.   fill (arrow p);
  450. enddef;
  451. style_def dbl_plain expr p =
  452.   draw_double p;
  453. enddef;
  454. style_def dbl_plain_arrow expr p =
  455.   draw_double_arrow p;
  456. enddef;
  457. style_def wiggly expr p =
  458.   draw (wiggly p);
  459. enddef;
  460. style_def dbl_wiggly expr p =
  461.   draw_double (wiggly p);
  462. enddef;
  463. style_def curly expr p =
  464.   draw (curly p);
  465. enddef;
  466. style_def dbl_curly expr p =
  467.   draw_double (curly p);
  468. enddef;
  469. style_def dashes expr p_arg =
  470.  save dpp;
  471.  numeric dpp;
  472.  dpp = ceiling (pixlen (p_arg, 10) / (dash_len * length(p_arg)));
  473.  for k=0 upto dpp*length(p_arg) - 1:
  474.   draw point k/dpp of p_arg ..
  475.    point (k+.5)/dpp of p_arg;
  476.  endfor
  477. enddef;
  478. style_def dbl_dashes expr p =
  479.  save dpp;
  480.  numeric dpp;
  481.  dpp = ceiling (pixlen (p, 10) / (dash_len * length(p)));
  482.  for k=0 upto dpp*length(p) - 1:
  483.   draw_double point k/dpp of p ..
  484.    point (k+.5)/dpp of p;
  485.  endfor
  486. enddef;
  487. style_def dbl_dashes_arrow expr p =
  488.   draw_dbl_dashes p;
  489.   fill (arrow p);
  490. enddef;
  491. style_def dashes_arrow expr p =
  492.   draw_dashes p;
  493.   fill (arrow p);
  494. enddef;
  495. style_def dots expr p_arg =
  496.  save dpp;
  497.  numeric dpp;
  498.  dpp = ceiling (pixlen (p_arg, 10) / (dot_len * length(p_arg)));
  499.  for k=0 upto dpp*length(p_arg):
  500.   drawdot point k/dpp of p_arg;
  501.  endfor
  502. enddef;
  503. style_def dbl_dots expr p_arg =
  504.   save dpp;
  505.   numeric dpp;
  506.   dpp = ceiling (pixlen (p_arg, 10) / (dot_len * length(p_arg)));
  507.   begingroup
  508.     pen oldpen;
  509.     oldpen := currentpen;
  510.     pickup oldpen scaled 3; % draw a thick linn
  511.     for k=0 upto dpp*length(p_arg):
  512.       drawdot point k/dpp of p_arg;
  513.     endfor
  514.     pickup oldpen;
  515.     cullit;
  516.     for k=0 upto dpp*length(p_arg):
  517.       undrawdot point k/dpp of p_arg;
  518.     endfor
  519.     cullit; % and remove the stuffing
  520.   endgroup;
  521. enddef;
  522. style_def dbl_dots_arrow expr p =
  523.   draw_dbl_dots p;
  524.   fill (arrow p);
  525. enddef;
  526. style_def dots_arrow expr p =
  527.   draw_dots p;
  528.   fill (arrow p);
  529. enddef;
  530. style_def double expr p_arg =
  531.   begingroup
  532.     pen oldpen;
  533.     oldpen := currentpen;
  534.     pickup oldpen scaled 3; % draw a thick linn
  535.     draw p_arg;
  536.     pickup oldpen;
  537.     cullit; undraw p_arg; cullit; % and remove the stuffing
  538.   endgroup;
  539. enddef;
  540. style_def double_arrow expr p =
  541.   draw_double p;
  542.   fill (arrow p);
  543. enddef;
  544. style_def vanilla expr p = draw_plain p enddef;
  545. style_def fermion expr p = draw_plain_arrow p enddef;
  546. style_def quark expr p = draw_plain_arrow p enddef;
  547. style_def electron expr p = draw_plain_arrow p enddef;
  548. style_def photon expr p = draw_wiggly p enddef;
  549. style_def boson expr p = draw_wiggly p enddef;
  550. style_def gluon expr p = draw_curly p enddef;
  551. style_def heavy expr p = draw_dbl_plain_arrow p enddef;
  552. style_def ghost expr p = draw_dots_arrow p enddef;
  553. style_def scalar expr p = draw_dashes_arrow p enddef;
  554. vardef fermion expr path_arg =
  555.   fill arrow (path_arg);
  556.   path_arg
  557. enddef;
  558. vardef photon expr path_arg =
  559.   wiggly path_arg
  560. enddef;
  561. vardef gluon expr path_arg =
  562.   curly path_arg
  563. enddef;
  564. tracingstats:=1;
  565. boolean vtracing;
  566. vtracing := false; % true
  567. def vinit =
  568.   save vhash;
  569.   numeric vlist.first, vlist.last;
  570.   vlist.first := 1;
  571.   vlist.last := 0;
  572.   pair vlist[]loc, lambda[][];
  573.   numeric vlist[]decor.size, vlist[]decor.sty, vlist[]decor.ang,
  574.     vlist[]arc.first, vlist[]arc.last,
  575.     vlist[]arc[], vlist[]arc[]lsr,
  576.     vlist[]arc[]tns, vlist[]arc[]lbl.dist,
  577.     vlist[]constr.first, vlist[]constr.last,
  578.     vlist[]constr[];
  579.   string vlist[]name, vlist[]lbl,
  580.     vlist[]arc[]sty, vlist[]arc[]lbl, vlist[]arc[]lbl.side;
  581.   numeric vlist[]lbl.ang, vlist[]lbl.side;
  582.   path vlist[]decor.shape;
  583. enddef;
  584. def vertices =
  585.   vlist.first upto vlist.last
  586. enddef;
  587. def varcs (text i) =
  588.   vlist[i]arc.first upto vlist[i]arc.last
  589. enddef;
  590. def vconstr (text i) =
  591.   vlist[i]constr.first upto vlist[i]constr.last
  592. enddef;
  593. vardef venter suffix v =
  594.   if not vexists v:
  595.     vlist.last := vlist.last + 1;
  596.     vhash.v := vlist.last;
  597.     vlist[vhash.v]name := str v;
  598.     vlist[vhash.v]loc := (whatever,whatever);
  599.     vlist[vhash.v]arc.first := 1;
  600.     vlist[vhash.v]arc.last := 0;
  601.     vlist[vhash.v]constr.first := 1;
  602.     vlist[vhash.v]constr.last := 0;
  603.     vlist[vhash.v]lbl := "";
  604.     vlist[vhash.v]lbl.ang := whatever;
  605.     vlist[vhash.v]lbl.dist := 3;
  606.   fi
  607. enddef;
  608. vardef vexists suffix v =
  609.   if known vhash.v: true else: false fi
  610. enddef;
  611. vardef vlookup suffix v =
  612.   if vexists v: vhash.v else: 0 fi
  613. enddef;
  614. vardef vloc suffix v =
  615.   vlist[vlookup v]loc
  616. enddef;
  617. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  618. vardef vconnect (expr linesty) (text vl) =
  619.   save from, nfrom, nto, nopt, sty;
  620.   numeric from, nfrom, nto, nopt;
  621.   string sty;
  622.   getopt (opt, linesty);
  623.   sty := opt[opt.first];
  624.   if known opt[opt.first]arg:
  625.     message "feynmf: line styles don't take arguments.  "
  626.              & "Argument `" & opt[opt.first]arg & "' ignored.";
  627.   fi
  628.   opt.first := opt.first + 1;
  629.   forsuffixes to = vl:
  630.     venter to;
  631.     nto := vlookup to;
  632.     if known nfrom:
  633.       vlist[nfrom]arc.last := vlist[nfrom]arc.last + 1;
  634.       vlist[nto]arc.last := vlist[nto]arc.last + 1;
  635.       vlist[nfrom]arc[vlist[nfrom]arc.last] := nto;
  636.       vlist[nto]arc[vlist[nto]arc.last] := nfrom;
  637.       vlist[nfrom]arc[vlist[nfrom]arc.last]tns := 1;
  638.       vlist[nto]arc[vlist[nto]arc.last]tns := 1;
  639.       vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 0;
  640.       vlist[nfrom]arc[vlist[nfrom]arc.last]lbl := "";
  641.       vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side := "";
  642.       vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist := 3;
  643.       for nopt = opt.first upto opt.last:
  644.         if match_option (opt[nopt], "tension"):
  645.           get_argument (opt[nopt], scantokens (opt[nopt]arg),
  646.                         vlist[nfrom]arc[vlist[nfrom]arc.last]tns);
  647.           get_argument (opt[nopt], scantokens (opt[nopt]arg),
  648.                         vlist[nto]arc[vlist[nto]arc.last]tns);
  649.         elseif match_option (opt[nopt], "left"):
  650.           if known opt[nopt]arg:
  651.             vlist[nfrom]arc[vlist[nfrom]arc.last]lsr
  652.               := - scantokens (opt[nopt]arg);
  653.           else:
  654.             vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := -1;
  655.           fi
  656.         elseif match_option (opt[nopt], "straight"):
  657.           vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 0;
  658.           ignore_argument (opt[nopt], opt[nopt]arg);
  659.         elseif match_option (opt[nopt], "right"):
  660.           if known opt[nopt]arg:
  661.             vlist[nfrom]arc[vlist[nfrom]arc.last]lsr
  662.               := scantokens (opt[nopt]arg);
  663.           else:
  664.             vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 1;
  665.           fi
  666.         elseif match_option (opt[nopt], "label"):
  667.           get_argument (opt[nopt], opt[nopt]arg,
  668.                         vlist[nfrom]arc[vlist[nfrom]arc.last]lbl);
  669.         elseif match_option (opt[nopt], "label.side"):
  670.           get_argument (opt[nopt], opt[nopt]arg,
  671.                         vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side);
  672.         elseif match_option (opt[nopt], "label.dist"):
  673.           get_argument (opt[nopt], scantokens (opt[nopt]arg),
  674.                         vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist);
  675.         else:
  676.           ignore_option (opt[nopt], opt[nopt]arg);
  677.         fi
  678.       endfor
  679.       if valid_style sty:
  680.         vlist[nfrom]arc[vlist[nfrom]arc.last]sty := sty;
  681.       else:
  682.         errhelp "feynmf: your linestyle is not recognizable, "
  683.               & "check spelling and reprocess!";
  684.         errmessage "feynmf: line style `" & sty & "' not known, "
  685.                  & "replaced by `vanilla'";
  686.         vlist[nfrom]arc[vlist[nfrom]arc.last]sty := "vanilla";
  687.       fi
  688.     fi
  689.     nfrom := nto;
  690.   endfor
  691. enddef;
  692. vardef get_argument (expr opt, arg) (suffix variable) =
  693.   if known arg:
  694.     variable := arg;
  695.   else:
  696.     message "feynmf: option `" & opt & "' needs an argument.  Ignored.";
  697.   fi
  698. enddef;
  699. vardef ignore_argument (expr opt, arg) =
  700.   if known arg:
  701.     message "feynmf: option `" & opt & "' doesn't take an argument.  "
  702.           & "Argument `" & arg & "' ignored.";
  703.   fi
  704. enddef;
  705. vardef ignore_option (expr opt, arg)=
  706.   if known arg:
  707.     message "feynmf: ignoring option " & opt & "=" & arg & ".";
  708.   else:
  709.     message "feynmf: ignoring option " & opt & ".";
  710.   fi
  711. enddef;
  712. vardef vcyclen (expr sty) (suffix v) (expr n) =
  713.   for $ = 1 upto n - 1:
  714.     vconnect (sty, v[$], v[$+1]);
  715.   endfor
  716.   vconnect (sty, v[n], v[1]);
  717. enddef;
  718. vardef vrcyclen (expr sty) (suffix v) (expr n) =
  719.   vconnect (sty, v[1], v[n]);
  720.   for $ = n downto 2:
  721.     vconnect (sty, v[$], v[$-1]);
  722.   endfor
  723. enddef;
  724. vardef vforce (expr z) (suffix v) =
  725.   venter v;
  726.   vlist[vlookup v]loc := z;
  727. enddef;
  728. vardef vshift (expr z) (text vl) =
  729.   forsuffixes $=vl:
  730.     if vexists $:
  731.       vlist[vlookup $]loc := vlist[vlookup $]loc + z;
  732.     fi
  733.   endfor
  734. enddef;
  735. vardef vconstraint (expr z) (text vl) =
  736.   save nfrom, nto;
  737.   numeric nfrom, nto;
  738.   forsuffixes to = vl:
  739.     venter to;
  740.     nto := vlookup to;
  741.     if known nfrom:
  742.       vlist[nfrom]constr.last := vlist[nfrom]constr.last + 1;
  743.       vlist[nto]constr.last := vlist[nto]constr.last + 1;
  744.       vlist[nfrom]constr[vlist[nfrom]constr.last] := nto;
  745.       vlist[nto]constr[vlist[nto]constr.last] := nfrom;
  746.       vlist[nto]loc = vlist[nfrom]loc + z;
  747.     fi
  748.     nfrom := nto;
  749.   endfor
  750. enddef;
  751. vardef vlabel (expr s) (suffix v) =
  752.   venter v;
  753.   vlist[vlookup v]lbl := s;
  754. enddef;
  755. vardef vvertex (expr vtxsty) (text vl) =
  756.   save nopt, sty, arg;
  757.   numeric nopt, arg;
  758.   string sty;
  759.   getopt (opt, vtxsty);
  760.   forsuffixes v = vl:
  761.     venter v;
  762.     n := vlookup v;
  763.     for nopt = opt.first upto opt.last:
  764.       if match_option (opt[nopt], "label"):
  765.         get_argument (opt[nopt], opt[nopt]arg, vlist[n]lbl);
  766.       elseif match_option (opt[nopt], "label.angle"):
  767.         get_argument (opt[nopt], scantokens (opt[nopt]arg),
  768.                       vlist[n]lbl.ang);
  769.       elseif match_option (opt[nopt], "label.dist"):
  770.         get_argument (opt[nopt], scantokens (opt[nopt]arg),
  771.                       vlist[n]lbl.dist);
  772.       elseif match_option (opt[nopt], "decoration.shape"):
  773.         if known opt[nopt]arg:
  774.           if match_prefix (opt[nopt]arg, "circle"):
  775.             vlist[n]decor.shape := fullcircle;
  776.           elseif match_prefix (opt[nopt]arg, "square"):
  777.             vlist[n]decor.shape := unitsquare shifted -(.5,.5);
  778.           elseif match_prefix (opt[nopt]arg, "triangle"):
  779.             vlist[n]decor.shape := polygon 3;
  780.           elseif match_prefix (opt[nopt]arg, "triagon"):
  781.             vlist[n]decor.shape := polygon 3;
  782.           elseif match_prefix (opt[nopt]arg, "diamond"):
  783.             vlist[n]decor.shape := polygon 4;
  784.           elseif match_prefix (opt[nopt]arg, "tetragon"):
  785.             vlist[n]decor.shape := polygon 4;
  786.           elseif match_prefix (opt[nopt]arg, "pentagon"):
  787.             vlist[n]decor.shape := polygon 5;
  788.           elseif match_prefix (opt[nopt]arg, "hexagon"):
  789.             vlist[n]decor.shape := polygon 6;
  790.           elseif match_prefix (opt[nopt]arg, "triagram"):
  791.             vlist[n]decor.shape := polygram 3;
  792.           elseif match_prefix (opt[nopt]arg, "tetragram"):
  793.             vlist[n]decor.shape := polygram 4;
  794.           elseif match_prefix (opt[nopt]arg, "pentagram"):
  795.             vlist[n]decor.shape := polygram 5;
  796.           elseif match_prefix (opt[nopt]arg, "hexagram"):
  797.             vlist[n]decor.shape := polygram 6;
  798.           else:
  799.             if feynmfwizard:
  800.               vlist[n]decor.shape := scantokens(opt[nopt]arg);
  801.             else:
  802.               message "feynmf: invalid argument `" & opt[nopt]arg
  803.                     & "' to option `decor.shape'.  Ignored.";
  804.             fi
  805.           fi
  806.         else:
  807.           message "feynmf: option `decor.shape' needs an argument.  Ignored.";
  808.         fi
  809.       elseif match_option (opt[nopt], "decoration.filled"):
  810.         get_argument (opt[nopt], scantokens (opt[nopt]arg),
  811.                       vlist[n]decor.sty);
  812.       elseif match_option (opt[nopt], "decoration.size"):
  813.         get_argument (opt[nopt], scantokens (opt[nopt]arg),
  814.                       vlist[n]decor.size);
  815.       elseif match_option (opt[nopt], "decoration.angle"):
  816.         get_argument (opt[nopt], scantokens (opt[nopt]arg),
  817.                       vlist[n]decor.ang);
  818.       else:
  819.         ignore_option (opt[nopt], opt[nopt]arg);
  820.       fi
  821.     endfor
  822.   endfor
  823. enddef;
  824. vardef vvertexn (expr vtxsty) (suffix v) (expr n) =
  825.   vvertex (vtxsty, vmklist (v, n));
  826. enddef;
  827. vardef vblob (expr bd) (text vl)=
  828.   forsuffixes $=vl:
  829.     if not vexists $: venter $; fi
  830.     vlist[vlookup $]decor.shape := fullcircle;
  831.     vlist[vlookup $]decor.size := bd;
  832.     vlist[vlookup $]decor.sty := .5;
  833.  endfor
  834. enddef;
  835. vardef vdot (text vl)=
  836.   forsuffixes $=vl:
  837.     if not vexists $: venter $; fi
  838.     vlist[vlookup $]decor.shape := fullcircle;
  839.     vlist[vlookup $]decor.size := dot_size;
  840.     vlist[vlookup $]decor.sty := 1;
  841.  endfor
  842. enddef;
  843. vardef vdotn (suffix v) (expr n) =
  844.   vdot (vmklist (v, n));
  845. enddef;
  846. vardef vblobn (suffix v) (expr n) =
  847.   vblob (vmklist (v, n));
  848. enddef;
  849. vardef left_gallery = (.1w,0)..(0,.5h)..(.1w,h) enddef;
  850. vardef right_gallery = (.9w,0)..(w,.5h)..(.9w,h) enddef;
  851. vardef bottom_gallery = (0,.1h)..(.5w,0)..(w,.1h) enddef;
  852. vardef top_gallery = (0,.9h)..(.5w,h)..(w,.9h) enddef;
  853. vardef surround_gallery =
  854.   superellipse ((w,.5h), (.5w,h), (0,.5h), (.5w,0), .75)
  855. enddef;
  856. vardef vleft (text vl) = vdistribute (left_gallery, vl) enddef;
  857. vardef vright (text vl) = vdistribute (right_gallery, vl) enddef;
  858. vardef vbottom (text vl) = vdistribute (bottom_gallery, vl) enddef;
  859. vardef vtop (text vl) = vdistribute (top_gallery, vl) enddef;
  860. vardef vsurround (text vl) = vdistribute (surround_gallery, vl) enddef;
  861. vardef vdistribute (expr p) (text vl) =
  862.   save numv, len, off;
  863.   numeric numv, len, off;
  864.   numv = count (vl);
  865.   if cycle p: numv := numv + 1; fi
  866.   len := length (p);
  867.   if numv = 1:
  868.     vforce (point len/2 of p, vl);
  869.   else:
  870.     off := 0;
  871.     forsuffixes $ = vl:
  872.       vforce (point off of p, $);
  873.       off := off + len/(numv-1);
  874.     endfor
  875.   fi
  876. enddef;
  877. def vmklist (suffix v) (expr n) =
  878.   for $ = 1 upto n-1: v[$], endfor v[n]
  879. enddef;
  880. vardef vleftn (suffix v) (expr n) =
  881.   vleft (vmklist (v, n));
  882. enddef;
  883. vardef vrightn (suffix v) (expr n) =
  884.   vright (vmklist (v, n));
  885. enddef;
  886. vardef vbottomn (suffix v) (expr n) =
  887.   vbottom (vmklist (v, n));
  888. enddef;
  889. vardef vtopn (suffix v) (expr n) =
  890.   vtop (vmklist (v, n));
  891. enddef;
  892. vardef vsurroundn (suffix v) (expr n) =
  893.   vsurround (vmklist (v, n));
  894. enddef;
  895. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  896. vardef vposition =
  897.   for i = vertices:
  898.     if unknown vlist[i]loc:
  899.       origin = origin
  900.       for j = varcs (i):
  901.         + vlist[i]arc[j]tns * (vlist[i]loc - vlist[vlist[i]arc[j]]loc)
  902.       endfor
  903.       for j = vconstr (i):
  904.         if i < vlist[i]constr[j]:
  905.           + lambda[i][vlist[i]constr[j]]
  906.         else:
  907.           - lambda[vlist[i]constr[j]][i]
  908.         fi
  909.       endfor;
  910.     fi
  911.   endfor
  912.   if vtracing: vdump; fi
  913. enddef;
  914. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  915. vardef vdraw =
  916.   for i = vertices:
  917.     if not known vlist[i]loc:
  918.       errhelp "Your graph specification was not complete (probably a "
  919.             & "lone vertex).            Check logic and reprocess!";
  920.       errmessage "feynmf: vertex `" & vlist[i]name & "' not determined, "
  921.                & "replaced by `(0,0)'.";
  922.       vlist[i]loc := origin;
  923.     fi
  924.     if unknown vlist[i]decor.size:
  925.       vlist[i]decor.size = decor_size;
  926.     fi
  927.   endfor
  928.   for i = vertices:
  929.     for j = varcs (i):
  930.       if known vlist[i]arc[j]sty:
  931.         vdraw_arc (vlist[i]arc[j]sty,
  932.                    cut_decors (vlist[i],
  933.                                vbuild_arc (vlist[i]arc[j]lsr,
  934.                                            vlist[i]loc,
  935.                                            vlist[vlist[i]arc[j]]loc),
  936.                                vlist[vlist[i]arc[j]]),
  937.                    vlist[i]arc[j]lbl);
  938.       fi
  939.     endfor;
  940.     vdraw_vertex_label vlist[i];
  941.     vdraw_vertex vlist[i];
  942.   endfor
  943. enddef;
  944. vardef vbuild_arc (expr lsr, from, to) =
  945.   if lsr = 0:
  946.     from -- to
  947.   else:
  948.     from
  949.       .. (1-lsr)/2 *(to rotatedabout (.5[from,to], 90))
  950.          + (1+lsr)/2 * (to rotatedabout (.5[from,to], -90))
  951.       .. to
  952.   fi
  953. enddef;
  954. vardef vdraw_arc (expr sty, arc) (suffix lbl) =
  955.   scantokens ("draw_" & sty) (arc);
  956.   vdraw_arc_label (arc, lbl);
  957. enddef;
  958. vardef vdraw_arc_label (expr arc) (suffix lbl) =
  959.   if lbl <> "":
  960.     save _a, _z, _zz, _r;
  961.     numeric _a;
  962.     pair _z, _zz, _r;
  963.     _z := point .5 length (arc) of arc;
  964.     _r := direction .5 length (arc) of arc rotated - 90;
  965.     if lbl.side = "left":
  966.       _a := angle (-_r);
  967.     elseif lbl.side = "right":
  968.       _a := angle (_r);
  969.     else:
  970.       _zz = _z - .5[point 0 of arc, point infinity of arc];
  971.       if ((_zz if length (_zz) >  0: / length (_zz) fi)
  972.           dotprod _r) >= 0:
  973.         _a := angle (_r);
  974.       else:
  975.         _a := angle (-_r);
  976.       fi
  977.     fi
  978.     LaTeX_text (_z + lbl.dist * thick * dir _a, _a, lbl);
  979.   fi
  980. enddef;
  981. vardef vdraw_vertex_label suffix v =
  982.   if v.lbl <> "":
  983.     save a;
  984.     numeric a;
  985.     if unknown v.lbl.ang:
  986.       if v.loc = (.5w,.5h):
  987.         a := 0;
  988.       else:
  989.         a := angle (v.loc - (.5w,.5h));
  990.       fi
  991.     else:
  992.       a := v.lbl.ang;
  993.     fi
  994.     LaTeX_text (v.loc + v.lbl.dist * thick * dir a, a, v.lbl);
  995.   fi
  996. enddef;
  997. vardef vdraw_vertex suffix v =
  998.   save cmd;
  999.   string cmd;
  1000.   if known v.decor.shape:
  1001.     cmd := "filldraw";
  1002.     if known v.decor.sty:
  1003.       if v.decor.sty = 0:
  1004.         cmd := "draw";
  1005.       elseif abs (v.decor.sty) >= 1:
  1006.         cmd := "filldraw";
  1007.       elseif v.decor.sty > 0:
  1008.         cmd := "shadedraw";
  1009.       else:
  1010.         cmd := "hatchdraw";
  1011.       fi
  1012.     fi
  1013.     scantokens (cmd) v.decor.shape
  1014.       if known v.decor.ang: rotated v.decor.ang fi
  1015.       scaled v.decor.size shifted v.loc;
  1016.   fi
  1017. enddef;
  1018. vardef polygon expr n =
  1019.   if n > 2:
  1020.     for i = 1 upto n:
  1021.       (.5up rotated (360i/n)) --
  1022.     endfor
  1023.     cycle
  1024.   else:
  1025.     fullcircle
  1026.   fi
  1027. enddef;
  1028. vardef polygram expr n =
  1029.   if n > 2:
  1030.     for i = 1 upto n:
  1031.       (.5up rotated (360i/n)) --
  1032.       (.2up rotated (360(i+.5)/n)) --
  1033.     endfor
  1034.     cycle
  1035.   else:
  1036.     fullcircle
  1037.   fi
  1038. enddef;
  1039. vardef LaTeX expr text =
  1040.   message (":" & jobname & "." & decimal charcode & ":" & text & "%%%")
  1041. enddef;
  1042. vardef LaTeX_text (expr z, a, txt) =
  1043.   LaTeX "\fmfL(" & (decimal (xpart z/LaTeX_unitlength)) & ","
  1044.       & (decimal (ypart z/LaTeX_unitlength)) & ","
  1045.       & (voctant a) & "){" & txt & "}";
  1046. enddef;
  1047. vardef voctant expr a =
  1048.   voctant_list[floor (a/45 + .5)]
  1049. enddef;
  1050. string voctant_list[];
  1051. voctant_list[-4] := "r";
  1052. voctant_list[-3] := "rt";
  1053. voctant_list[-2] := "t";
  1054. voctant_list[-1] := "lt";
  1055. voctant_list[0] := "l";
  1056. voctant_list[1] := "lb";
  1057. voctant_list[2] := "b";
  1058. voctant_list[3] := "rb";
  1059. voctant_list[4] := "r";
  1060. vardef vdump =
  1061.   message ">>>>> Vertices and arcs for diagram #" & decimal charcode
  1062.         & " of " & jobname & ".mf:";
  1063.   for i = vertices:
  1064.     message "> " & vlist[i]name & "=" & decimal_pair (vlist[i]loc)
  1065.           & ": #lines="
  1066.           & decimal (vlist[i]arc.last - vlist[i]arc.first + 1)
  1067.           if vlist[i]lbl <> "":
  1068.             & ", lbl=" & vlist[i]lbl
  1069.             & ", l.angle=" & decimal_ (vlist[i]lbl.ang)
  1070.             & ", l.dist=" & decimal_ (vlist[i]lbl.dist)
  1071.           fi
  1072.           & ".";
  1073.   endfor
  1074.   for i = vertices:
  1075.     for j = varcs (i):
  1076.       if known vlist[i]arc[j]sty:
  1077.         message "> " & vlist[i]name & "*" & vlist[vlist[i]arc[j]]name
  1078.                 & ": " & vlist[i]arc[j]sty
  1079.                 & ", tns=" & decimal_ (vlist[i]arc[j]tns)
  1080.                 & ", lsr=" & decimal_ (vlist[i]arc[j]lsr)
  1081.                 if vlist[i]arc[j]lbl <> "":
  1082.                   & ", lbl=" & vlist[i]arc[j]lbl
  1083.                   & ", l.side=" & vlist[i]arc[j]lbl.side
  1084.                   & ", l.dist=" & decimal_ (vlist[i]arc[j]lbl.dist)
  1085.                 fi
  1086.                 & ".";
  1087.       fi
  1088.     endfor
  1089.     for j = vconstr (i):
  1090.       if i < vlist[i]constr[j]:
  1091.         save z;
  1092.         pair z;
  1093.         z = vlist[vlist[i]constr[j]]loc - vlist[i]loc;
  1094.         message "> " & vlist[i]name & "&"
  1095.                 & vlist[vlist[i]constr[j]]name
  1096.                 & ": " & decimal_pair (z);
  1097.       fi
  1098.     endfor;
  1099.   endfor
  1100. enddef;
  1101. vardef decimal_ (text n) =
  1102.   if known n: decimal n else: "?" fi
  1103. enddef;
  1104. vardef decimal_pair (text z) =
  1105.   "(" & decimal_ (xpart z) & "," & decimal_ (ypart z) & ")"
  1106. enddef;
  1107. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1108. def show_diagram_ expr frame =
  1109.   if (screen_cols < w + 2 xpart frame) or (screen_rows < h + 2 ypart frame):
  1110.     screen_cols := w + 2 xpart frame;
  1111.     screen_rows := h + 2 ypart frame;
  1112.     openwindow currentwindow
  1113.       from origin to (screen_rows, screen_cols)
  1114.       at (- xpart frame, h + ypart frame);
  1115.   fi
  1116.   showit_;
  1117.   if showstopping > 0:
  1118.     stop "This is diagram #" & decimal charcode
  1119.        & ".  Hit return to continue...";
  1120.   fi
  1121. enddef;
  1122. def show_diagram =
  1123.   def show_diagram =
  1124.     display blankpicture inwindow currentwindow;
  1125.     show_diagram_
  1126.   enddef;
  1127.   show_diagram_
  1128. enddef;
  1129. def show_all_diagrams expr frame =
  1130.   def showit = show_diagram frame enddef;
  1131.   displaying:=1;
  1132. enddef;
  1133. endinput;
  1134. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1135. \endinput
  1136. %% 
  1137. %% End of file `feynmf.mf'.
  1138.